home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / packet / p_aa4re / bb212src / bbwinm1.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-11-26  |  3.4 KB  |  120 lines
  1. (*===========================================================================*)
  2. (* Miscellaneous # 1 -- Cursor control/Erase EOL/Color                       *)
  3. (*                                                                           *)
  4. (*   Copyright 1988, 1989 by H. Roy Engehausen.  All rights reserved.        *)
  5. (*   This software may be freely distributed and used, but it may not        *)
  6. (*   under any circumstances be sold by anyone other than the author.        *)
  7. (*   It may be distributed by a commercial company as long as it is          *)
  8. (*   for no cost.                                                            *)
  9. (*                                                                           *)
  10. (*===========================================================================*)
  11.  
  12. (*===========================================================================*)
  13. (* Color select                                                              *)
  14. (*===========================================================================*)
  15.  
  16. PROCEDURE color(parm:WORD);
  17.  
  18.   {$UNDEF DEBUG}
  19.  
  20.   BEGIN
  21.  
  22.     {$IFDEF DEPTH}
  23.     stack_depth;
  24.     {$ENDIF}
  25.  
  26.     {$IFDEF DEBUG}
  27.       WRITELN('COLORS - ', (parm MOD 16) + 16*(parm SHR 7), '/',
  28.                                                           (parm SHR 4) MOD 16);
  29.       DELAY(1000);
  30.       EXIT;
  31.     {$ENDIF}
  32.  
  33.     TEXTCOLOR((parm MOD 16) + 16*(parm SHR 7));
  34.     TEXTBACKGROUND((parm SHR 4) MOD 16);
  35.  
  36.   END;
  37.  
  38. (*===========================================================================*)
  39. (* Window erase to end of line                                               *)
  40. (*===========================================================================*)
  41.  
  42. PROCEDURE window_erase_eol(wn : BYTE);
  43.  
  44.   BEGIN;
  45.  
  46.     {$IFDEF DEPTH}
  47.     stack_depth;
  48.     {$ENDIF}
  49.  
  50.  
  51.     IF current_window <> wn THEN
  52.       window_select(wn);
  53.  
  54.     WITH window_array[wn] DO
  55.       BEGIN;
  56.  
  57.         IF NOT window_act THEN
  58.           EXIT;
  59.  
  60.         IF wn = window_reset THEN
  61.           color(opt_block.status_color)
  62.         ELSE
  63.           color(active_tcb^.w_color);
  64.  
  65.         CLREOL;
  66.  
  67.         GOTOXY(window_cursor, window_location[window_loc].window_wl);
  68.  
  69.       END;
  70.  
  71.   END;
  72.  
  73. (*===========================================================================*)
  74. (* Window cursor locate/update                                               *)
  75. (*===========================================================================*)
  76.  
  77. FUNCTION window_cursor_update(new_place : BYTE) : BYTE;
  78.   BEGIN;
  79.  
  80.     {$IFDEF DEPTH}
  81.     stack_depth;
  82.     {$ENDIF}
  83.  
  84.     WITH window_array[current_window] DO
  85.       BEGIN;
  86.         window_cursor        := WHEREX;
  87.         window_cursor_update := window_cursor;
  88.         IF new_place <> 0 THEN
  89.           BEGIN;
  90.             window_cursor := new_place;
  91.             GOTOXY(new_place, WHEREY);
  92.           END;
  93.       END;
  94.  
  95.   END;
  96.  
  97. (*===========================================================================*)
  98. (* Set cursor size                                                           *)
  99. (*===========================================================================*)
  100.  
  101. PROCEDURE window_cursor_size(cursor_size : BOOLEAN);
  102.  
  103.   VAR
  104.     regs : REGISTERS;
  105.  
  106.   BEGIN;
  107.  
  108.     {$IFDEF DEPTH}
  109.     stack_depth;
  110.     {$ENDIF}
  111.  
  112.     regs.AX := $0100;
  113.     IF cursor_size THEN
  114.       regs.CX := window_cursor_block
  115.     ELSE
  116.       regs.CX := window_cursor_orig;
  117.     INTR($10, regs);
  118.  
  119.   END;
  120.